-- card: 7962 from stack: in.3
-- bmap block id: 0
-- flags: 4000
-- background id: 3241
-- name: RInstall
----- HyperTalk script -----
on Install
  get ChooseTargetStack()
  InstallResource XCMD,RInstall,it
end Install


-- part 1 (field)
-- low flags: 81
-- high flags: 2007
-- rect: left=12 top=26 right=298 bottom=491
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 0
-- font id: 22
-- text size: 10
-- style flags: 0
-- line height: 13
-- part name: Source


-- part 2 (button)
-- low flags: 00
-- high flags: A003
-- rect: left=299 top=300 right=322 bottom=438
-- title width / last selected line: 0
-- icon id / first selected line: 0 / 0
-- text alignment: 1
-- font id: 0
-- text size: 12
-- style flags: 0
-- line height: 16
-- part name: Show Pascal Source
----- HyperTalk script -----
on mouseUp
  set the visible of card field 1 to not the visible of card field 1
  if the visible of card field 1 is true then
    set the name of me to "Hide Pascal Source"
  else set the name of me to "Show Pascal Source"
end mouseUp



-- part contents for background part 16
----- text -----
RINSTALL XCMD version 1.1
Kevin Calhoun

RInstall copies any resource contained in any currently open resource file to a file you specify by full pathname.  It automatically removes from the target file any resource of the same type and name (or of the same type and resource ID) as the resource to be copied.

INVOKING RINSTALL

RInstall resType,resName,fileName

The first parameter, resType, is that type of resource you want to install.  The second parameter, resName, is the name of the resource you want to install.  The third parameter, fileName, is the full pathname of the file into which the resource is to be copied.

If an error occurs, RInstall returns an error message, the first word of which is 
"Error".

REVISION HISTORY
30 April 1989  1.0
22 July 1989  No longer leaves a NIL master pointer behind when replacing a resource.

-- part contents for card part 1
----- text -----
UNIT RInstall;

{ RInstall XCMD ©1989 by the Trustees of Dartmouth College }
{ Written by Kevin Calhoun }

(*
Pascal RInstall.p
Link  -m ENTRYPOINT ∂
    -o "YourFile" ∂
    -rt XCMD=3128 ∂
    -sn Main=RInstall ∂
    RInstall.p.o ∂
    "{Libraries}"interface.o ∂
    "{PLibraries}"Paslib.o ∂
    "{Libraries}"HyperXLib.o
*)

{$R-}

INTERFACE
  USES
    Types,
    Memory,
    Events,
    Windows,
    Files,
    ToolUtils,
    Resources,
    SysEqu,
    Errors,
    HyperXCmd;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);

IMPLEMENTATION

  PROCEDURE ResInstall (paramPtr : XCMDPtr); FORWARD;

  PROCEDURE EntryPoint (paramPtr : XCMDPtr);
  BEGIN
    ResInstall(paramPtr);
  END;

  PROCEDURE PassReturnValue (paramPtr: XCMDPtr; theMsg : Str255); { set theResult and quit }
  BEGIN
    paramPtr^.returnValue := PasToZero(paramPtr, theMsg);
  END;

  FUNCTION MyOpenResFile(fileName: Str255; VAR refNum: INTEGER;
                          VAR wasOpen: BOOLEAN): OSErr;
    TYPE
      HandlePtr = ^Handle;
    VAR
      oldTopMapHndl: Handle;
  BEGIN
    MyOpenResFile := noErr;
    oldTopMapHndl := HandlePtr(TopMapHndl)^;  { remember current TopMapHndl }
    refNum := OpenResFile(fileName);          { open resource file }
    IF (refNum = -1) THEN { error opening file }
      BEGIN
      MyOpenResFile := ResError;
      EXIT(MyOpenResFile);
      END
    ELSE
      IF (oldTopMapHndl = HandlePtr(TopMapHndl)^) THEN wasOpen := TRUE
        { no change -- it was open }
      ELSE wasOpen := FALSE;
        { res file wasn't open before }
  END;

  PROCEDURE RemoveResource(rType: ResType; resID: INTEGER; name: Str255);
    VAR
      resAlready: Handle;
  BEGIN
    SetResLoad(FALSE);
    REPEAT
      resAlready := Get1Resource(rType, resID);
      IF resAlready <> NIL THEN
        BEGIN
          RmveResource(resAlready);
          DisposHandle(resAlready);
        END;
    UNTIL resAlready = NIL;
    REPEAT
      resAlready := Get1NamedResource(rType, name);
      IF resAlready <> NIL THEN
        BEGIN
          RmveResource(resAlready);
          DisposHandle(resAlready);
        END;
    UNTIL resAlready = NIL;
    SetResLoad(TRUE);
  END;
    
  PROCEDURE ResInstall(paramPtr: XCMDPtr);
    LABEL
      99,100;
    VAR
      err: OSErr;
      targetFile, curFile: INTEGER;
      str: Str255;
      rType: ResType;
      resource: Handle;
      resID: INTEGER;
      attrs: INTEGER;
      targetStack: Str255;
      wasOpen: BOOLEAN;
      
      PROCEDURE SetReturnValue;
      BEGIN
        IF err <> noErr THEN
          BEGIN
          NumToStr(paramPtr, err, str);
          PassReturnValue(paramPtr,CONCAT('Error ', str));
          END;
      END;
      
      PROCEDURE BailOut;
      BEGIN
        IF resource <> NIL THEN DisposHandle(resource);
        SetReturnValue;
        EXIT(ResInstall);
      END;

  BEGIN
    err := noErr;
    resource := NIL;
    curFile := CurResFile;
    
    IF paramPtr^.paramCount < 3 THEN
      BEGIN
      PassReturnValue(paramPtr,'RInstall XCMD 1.1 ©1989 Dartmouth College');
      Exit(ResInstall);
      END;
      
    BlockMove(paramPtr^.params[1]^,@rType,4);
    ZeroToPas(paramPtr, paramPtr^.params[2]^, str);
    
    resource := GetNamedResource(rType, str);
    err := ResError;
    IF err <> noErr THEN GOTO 100;
    
    GetResInfo(resource, resID, rType, str);
    err := ResError;
    IF err <> noErr THEN BailOut;

    attrs := GetResAttrs(resource);
    
    err := HandToHand(resource);
    IF err <> noErr THEN BailOut;
    
    MoveHHi(resource);
    HLock(resource);
      
    ZeroToPas(paramPtr,paramPtr^.params[3]^,targetStack);
    
    err := MyOpenResFile(targetStack, targetFile, wasOpen);
    IF (targetFile = -1) AND (err = eofErr) THEN
      BEGIN
      wasOpen := FALSE;
      CreateResFile(targetStack);
      err := ResError;
      IF err = noErr THEN targetFile := OpenResFile(targetStack);
      END;
    IF (err <> noErr) OR (targetFile = -1) THEN BailOut;

    UseResFile(targetFile);
    RemoveResource(rType, resID, str);
    AddResource(resource, rType, resID, str);
    err := ResError;
    IF err <> noErr THEN
      BEGIN
      DisposHandle(resource);
      GOTO 99;
      END;

    SetResAttrs(resource, attrs);
    ChangedResource(resource);
    WriteResource(resource);
    UpdateResFile(targetFile);
    err := ResError;
    IF NOT wasOpen THEN CloseResFile(targetFile);
    
    99: UseResFile(curFile);
    100: SetReturnValue;
  END;

END.